;; runs planner and outputs a plan corpus

;;;;;;;;;;;;;;;;;;;;;;;;;; loads ;;;;;;;;;;;;;;;;;;;
(load "nlib") ;; my library
(load "shop2random") ;; planner
(load "planlib") ;; code for generating plan lib

;;;;;;;;;;;;;;;;;;;;;;;;;;;; shortcuts ;;;;;;;;;;;;;;;
(defun lcc () ;; loads this file
  (load "create-corpus-code"))

(defun gg (size &optional flat) ;; this one is for interactive calling
  (cc-main "monroe" size flat))

;;;;;;;;;;;;;;;;;;;;;;;;; global variables ;;;;;;;;;;;;;;;;;;;;
(defvar *flat-output* '()) ;; whether or not we're outputing for flat or hierarchical

(defparameter *corpus-max-depth* -1) ;; this keeps track of the maximum plan
   ;; tree depth for any of the sessions in the corpus, so we can
   ;; output it in the planlib and then use it in hierarchical recognition
   ;; to get around any recursive methods.  It's a hack, but not
   ;; too ugly a one - we could always constrain our planner to not
   ;; output plans > max-depth (if we were doing it in a more principled
   ;; way

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; code ;;;;;;;;;;;;;;;;;;

(defun extract-acts (plan)
  (every-other plan 1 0))

(defun munge (plan)
  (extract-acts (car plan)))

(defun get-goal (prob)
  (cdr (get-tasks prob)))

(defun get-schema (act)
  ;; returns the schema part of the action as an atom
  (car act))

(defun get-params (act)
  ;; returns the params part as a lst
  (cdr act))

(defun params-to-string (params)
  ;; turns a param list into a string (with commas)
  (if (endp params)
      ""
    (if (eq 1 (length params))
	(format nil "~A" (car params))
      ;; else longer than 1
      (format nil "~A,~A" 
	      (car params)
	      (params-to-string (cdr params))))))

(defun act-to-string (act)
  ;; turns the action into a string
  (format nil "~A(~A)" 
	  (get-schema act) 
	  (params-to-string (get-params act))))

(defun output-session-flat (goal plan outfile)
  ;; prints out this particular plan session
  (format outfile "~%Goal: ~A~%" (act-to-string goal))
  (mapcar (lambda (act)
	    (format outfile "  ~A~%" (act-to-string act)))
	  plan))

(defun choose-goal-schema ()
  ;; chooses the goal stochastically
  (problist-choose-stochastic *top-goals*))

(defun create-atloc (objname loc)
  ;; creates the form (atloc objname loc)
  `(atloc ,objname ,loc))

(defun gen-loc-pred (pred loc)
  ;; for a single predicate, returns a list of itself and its corresponding
  ;; atloc
  (list pred (gen-loc-obj (second pred) loc)))

(defun gen-loc-obj (obj loc)
    ;; for a single object, generate location
  (create-atloc obj loc))

(defun gen-fixed-loc (loclist possible-locs)
  ;; generates a location for a single list of predicates
  ;; and returns a list of those predicates and corresponding
  ;; atlocs
  (labels
   ((gather-list (loclist loc)
     ;; goes through each element of list and adds the atloc to it
     (if (endp loclist)
	 '()
       (append (gather-list (cdr loclist) loc)
	       (gen-loc-pred (car loclist) loc)))))
  (let ((loc (list-choose-uniform possible-locs)))
    (gather-list loclist loc))))
  

(defun gen-fixed-locs (list possible-locs)
  ;; generates the fixed-state-need-loc part of the state
  ;; list is a list of lists of predicates, each list representing
  ;; an equivalence set of items that need to be colocated
  ;; this returns a list of those predicates as well as their
  ;; corresponding atloc predicates
  (if (endp list)
      '()
    (append (gen-fixed-loc (car list) possible-locs)
	    (gen-fixed-locs (cdr list) possible-locs))))

(defun gen-fixed-start-state (fixed-state fixed-state-need-loc possible-locs)
  ;; generates the fixed part of the start state (everything but the
  ;; goal specific stuff
  (append fixed-state
	  (gen-fixed-locs fixed-state-need-loc possible-locs)))

(defun get-goal-func-name (schema-name)
  ;; this turns a schema name into a function name for that specific
  ;; function of the form gen-state-<schema-name>
  ;; returns this as a string
  (format nil "GEN-STATE-~A" schema-name))

(defun gen-object (&optional (type 'obj))
  (gensym (format nil "~A-" type)))

(defun gen-goal-and-state (schema)
  ;; generates the goal and the non-fixed part of the start state
  ;; i.e. the part that is specific to this goal schema
  ;; returns in form (goal state)
  ;; this function basically calls specific functions to the schema
  (let* ((schema-name (get-schema schema))
	(func-name (get-goal-func-name schema-name)))
    ;; this creates a function name based on the schema and calls it
    (apply (intern func-name) (list schema-name))))

(defun gen-goal-and-start-state (schema)
  ;; generates the goal and start state given the schema
  ;; it is easiest to just generate both together, since specific
  ;; code needs to be called for each goal schema
  ;; returns a 2-tuple of form (goal start-state)
  (let* ((fixed-start-state (gen-fixed-start-state *fixed-state*
						   *fixed-state-need-loc*
						   *possible-locs*))
	 (goal-and-state (gen-goal-and-state schema))
	 (goal (first goal-and-state))
	 (state (second goal-and-state))
	 (start-state (append state fixed-start-state)))
    `(,goal ,start-state)))

(defun generate-problem ()
  ;; generates the problem (goal and state) to be used to plan with
  ;; doesn't return anything, the problem is stored internally
  ;; in the planner as 'generated-problem
  (let* ((schema (choose-goal-schema))
	 (goal-and-start-state (gen-goal-and-start-state schema))
	 (goal (first goal-and-start-state))
	 (start-state (second goal-and-start-state)))
    (make-problem 'generated-problem 'monroe start-state goal)
    (format t "~%Choosing goal: ~S~%" (get-tasks 'generated-problem)))
)

(defun atomic-level (action)
  ;; if the action is an atomic-level action
  ;; the output is (1.0 (!act param) num)
  (numberp (car action)))

(defun output-goalchain (outfile goalstack action)
  ;; outputs a single line (i.e., goalchain and action)
  ;; also updates *corpus-max-depth*
  (let ((depth (1+ (length goalstack))))
    (if (> depth *corpus-max-depth*)
	(setq *corpus-max-depth* depth)))
  (format outfile "~A::~A~%"
	  (act-to-string action)
	  (perljoin ";"
		    (mapcar #'act-to-string goalstack))))

(defun output-session (goalstack recipe)
  ;; outputs for hierarchial plan
  (if (endp recipe)
      '() ;; nothing
    ;; else we still have actions in this recipe left
    (let ((this-action (car recipe)))
      (if (atomic-level this-action)
	  ;; we're at an atomic action
	  (let ((depth (1+ (length goalstack))))
	    (if (> depth *corpus-max-depth*)
		(progn
		  (setq *corpus-max-depth* depth)
		  ;;(format t "~%new record ~A ~A~%" depth goalstack)
		  ))
	    (setf (car recipe) (second (car recipe))))
	;;(let ((action (second this-action))) ;; pull out actual action
	;;(output-goalchain outfile goalstack action))
	;; else we're at a subgoal, recurse
	(output-session
			(cons (car this-action) goalstack) 
			(cdr this-action)))
      ;; go to next action in recipe
      (output-session goalstack (cdr recipe)))))

(defun output-plan (outfile plan)
  (if *flat-output*
      (let ((mplan (munge (second plan))))
	(output-session-flat
	 (get-goal 'generated-problem)
	 mplan
	 outfile))
    ;; else hierarchial output
    (let ((mplan (caaar plan)))
      (output-session (list (car mplan)) (cdr mplan))
      (format outfile "~%~A~%"
	      mplan)))) 

(defun osp (plan)
  ;; test function to output a single plan
  (with-open-file (outfile "test.pc" :direction :output
			   :if-exists :supersede
			   :if-does-not-exist :create)
		  (output-plan outfile plan)))


(defun get-random-plan (&optional (which :random))
  ;; returns a random plan
  (format T "~%generating problem")
  (generate-problem) ;; generates the prob with goal
  (format T "~%beginning to plan..")
  (let ((plan (find-plans 'generated-problem 
			  :which which 
			  :verbose 0 
			  :plan-tree t)))
    (format T "finished planning~%")
    plan))

(defun num-steps (plan)
  ;; returns the number of immediate children in the plan
  ;; i.e., the next level down (not atomic)
  (length plan))

(defun plan-ok (plan)
  ;; checks a generated plan to make sure we want to keep it
  ;; right now, makes sure plans are at least 2 steps (immediate subgoals) long
  ;; (1-step or 0-step plans aren't interesting to us)
; RAIN: Temporarily changed to 0 for testing, original was 2
  (if (> (num-steps (caaar plan)) 0)
      plan
    (progn
      (format t "~%bad plan: ~A~%" plan)
      '())))

(defun get-acceptable-plan ()
  ;; returns a random plan that is also acceptable (by plan-ok)
  (do ((plan))
      ((plan-ok plan) plan) ;; makes sure plan acceptable (e.g., >1 step)
      (setq plan
	    (get-random-plan))))

(defun get-sessions-single-problem (outfile)
  ;; creates a single problem and goal and extracts a plan for it
  ;; which it writes to outfile
  (output-plan
   outfile
   (get-acceptable-plan)
   ))

(defun get-sessions-open-file (outfile corpus-size)
  ;; auxiliary for get-sessions, takes an open file and writes
  ;; the corpus to it, called recursively to loop
  ;; to get each individual case
  (dotimes (x corpus-size)
    (format t "~%creating session~D~%" (1+ x))
    (get-sessions-single-problem outfile)
    ))

(defun get-sessions (filename corpus-size)
  (with-open-file (outfile filename :direction :output
			   :if-exists :supersede
			   :if-does-not-exist :create)
      (get-sessions-open-file outfile corpus-size)
      ;; will do this upon reading in into perl plan corpus
      ;;(if (not *flat-output*)
      ;;(format outfile "::Maximum Tree Depth: ~A~%" *corpus-max-depth*)))
      ))

(defun get-corpus (plib-filename corpus-filename corpus-size)
  ;; do corpus stuff
  (get-sessions corpus-filename corpus-size)
  ;; write out plan library
  ;(output-planlib plib-filename *corpus-max-depth*)
  )

(defun cc-main (input-name corpus-size &optional flat-output)
  ;; main routine
  ;; args = (string: corpus-name, num: corpus-size,[bool: flat-output])
  (setq *flat-output* flat-output) ;; set if we are outputting for flat or hierarchical
  (load (concatenate 'string input-name "/plib"))
  (load (concatenate 'string input-name "/state"))
  (get-corpus
          (concatenate 'string input-name "_plib.txt")
	      (concatenate 'string input-name "_corpus.txt")
          corpus-size))
